﻿Imports System.Globalization

Public Class LunarCalendarLocal
    ' 农历信息表（1900-2100，每年一个整数）
    ' 数据表示含义：
    ' 高 12~17 位：每个月大月(30天)或小月(29天)的标志（1为大月，0为小月）
    ' 低 4 位：闰月月份（0 为无闰月）
    ' （数据来源校准：1900~2100 年标准农历数据）
    Private Shared lunarInfo() As Integer = {
        &H84B6, &H4AE0, &HA570, &H5268, &HD260, &HD950, &H6AA8, &H56A0, &H9AD0, &H4AE0, '1900-1909
        &HA4E8, &HA4D0, &HD250, &HD520, &H5AA8, &HB5A0, &H56D0, &HD2B0, &H49B0, &HA4B8,
        &HA4B0, &HAA50, &H6D20, &HADA0, &H55B0, &H4AB8, &HA570, &HA570, &H5260, &HDA50,  '1920-1929
        &H5AA0, &H56D0, &H4AE8, &HA9B0, &H4B60, &HA4E8, &HA4E0, &HD260, &HE930, &H6AA8,
        &H6AA0, &HAB50, &H4B60, &HAAE0, &H5450, &H52B8, &HA9B0, &HA950, &HB4A0, &H6CA8,   '1940-1949
        &HAD50, &H4DA0, &HA5B0, &H4578, &HA570, &HA4E0, &HD260, &HD530, &H5AA8, &H56A0,
        &H9AD0, &H4AE8, &HA4E0, &HD260, &HD520, &HDAA0, &HB5A0, &H56D0, &H4AE8, &HA9B0,   '1960-1969
        &H4B60, &HA4E8, &HA4E0, &HD260, &HE930, &H6AA8, &H6AA0, &HAB50, &H4B60, &HAAE0,
        &H5450, &H52B8, &HA9B0, &HA950, &HB4A0, &H6CA8, &HAD50, &H4DA0, &HA5B0, &H4578,   '1980-1989
        &HA570, &HA4E0, &HD260, &HD530, &H5AA8, &H56A0, &H9AD0, &H4AE8, &HA4E0, &HD260,
        &HD520, &HDAA0, &HB5A0, &H56D0, &H4AE8, &HA9B0, &H4B60, &HA4E8, &HA4E0, &HD260,   '2000-2009
        &HE930, &H6AA8, &H6AA0, &HAB50, &H4B60, &HAAE0, &H5450, &H52B8, &HA9B0, &HA950,
        &HB4A0, &H6CA8, &HAD50, &H4DA0, &HA5B0, &H4578, &HA570, &HA4E0, &HD260, &HD530,   '2020-2029
        &H5AA8, &H56A0, &H9AD0, &H4AE8, &HA4E0, &HD260, &HD520, &HDAA0, &HB5A0, &H56D0,
        &H4AE8, &HA9B0, &H4B60, &HA4E8, &HA4E0, &HD260, &HE930, &H6AA8, &H6AA0, &HAB50,   '2040-2049
        &H4B60, &HAAE0, &H5450, &H52B8, &HA9B0, &HA950, &HB4A0, &H6CA8, &HAD50, &H4DA0,
        &HA5B0, &H4578, &HA570, &HA4E0, &HD260, &HD530, &H5AA8, &H56A0, &H9AD0, &H4AE8,   '2060-2069
        &HA4E0, &HD260, &HD520, &HDAA0, &HB5A0, &H56D0, &H4AE8, &HA9B0, &H4B60, &HA4E8,
        &HA4E0, &HD260, &HE930, &H6AA8, &H6AA0, &HAB50, &H4B60, &HAAE0, &H5450, &H52B8,   '2080-2089
        &HA9B0, &HA950, &HB4A0, &H6CA8, &HAD50, &H4DA0, &HA5B0, &H4578, &HA570, &HA4E0,
        &HD260, &HD530, &H5AA8, &H56A0, &H9AD0, &H4AE8, &HA4E0, &HD260, &HD520, &HDAA0    '2100止
    }
    ' 节气名表
    Private Shared solarTermNames() As String = {
    "小寒", "大寒", "立春", "雨水", "惊蛰", "春分",
    "清明", "谷雨", "立夏", "小满", "芒种", "夏至",
    "小暑", "大暑", "立秋", "处暑", "白露", "秋分",
    "寒露", "霜降", "立冬", "小雪", "大雪", "冬至"
}

    ' 节气分钟数表（1900年起每年的分钟差，常数算法）
    Private Shared solarTermInfo() As Double = {
    0, 21208, 42467, 63836, 85337, 107014,
    128867, 150921, 173149, 195551, 218072, 240693,
    263343, 285989, 308563, 331033, 353350, 375494,
    397447, 419210, 440795, 462224, 483532, 504758
}

    ' 计算节气日期
    Public Shared Function GetSolarTermDay(year As Integer, termIndex As Integer) As Date
        ' 每个节气的分钟差
        Dim minutes As Double = solarTermInfo(termIndex)
        ' 从北京时间1900年1月6日2:05开始计算
        Dim baseDate As DateTime = New DateTime(1900, 1, 6, 2, 5, 0, DateTimeKind.Utc)
        ' 加上(year - 1900) * 365.2422 天
        Dim days As Double = 365.2422 * (year - 1900) + (minutes / 1440.0)
        ' UTC 转北京时间 (UTC+8)
        Return baseDate.AddDays(days).AddHours(8)
    End Function

    ' 精确计算干支月（以节气立春切换年，以节气更换月份）
    Public Shared Function GetGanzhiMonthBySolarTerm(dateObj As Date) As String
        Dim year As Integer = dateObj.Year
        Dim month As Integer = dateObj.Month

        ' 找当前日期所在的节气（偶数节气就是月初节气，如立春为2）
        Dim currentTermIndex As Integer = -1

        For termIndex As Integer = 0 To 23 Step 2
            Dim termDate As Date = GetSolarTermDay(year, termIndex)
            Dim nextTermDate As Date
            If termIndex = 22 Then
                nextTermDate = GetSolarTermDay(year + 1, 0)
            Else
                nextTermDate = GetSolarTermDay(year, termIndex + 2)
            End If

            If dateObj >= termDate AndAlso dateObj < nextTermDate Then
                currentTermIndex = termIndex
                Exit For
            End If
        Next

        ' 当前节气对应农历月序号（以立春=寅月=1开始）
        Dim monthZhiIndex As Integer = ((currentTermIndex \ 2) + 2) Mod 12  ' 寅月 index=2
        ' 计算当年的正月（寅月）的天干
        Dim gzYear = GetGanzhiYearByLiChun(dateObj)
        Dim yearGanIndex As Integer = Array.IndexOf(tianGan, gzYear.Substring(0, 1))
        Dim firstMonthGanIndex As Integer = (yearGanIndex * 2 + 2) Mod 10

        ' 当月天干索引
        ' 月序 = 从寅月(1)到当前月的偏移
        Dim monthOrder As Integer = (monthZhiIndex + 12 - 2) Mod 12 ' 寅为0序
        Dim monthGanIndex As Integer = (firstMonthGanIndex + monthOrder) Mod 10

        Return tianGan(monthGanIndex) & diZhi(monthZhiIndex)
    End Function

    ' 根据立春精确确定干支年的年干支
    Public Shared Function GetGanzhiYearByLiChun(dateObj As Date) As String
        Dim yearGz As String
        Dim liChunDate As Date = GetSolarTermDay(dateObj.Year, 2) ' 立春 termIndex=2
        If dateObj < liChunDate Then
            yearGz = GetGanzhiYear(dateObj.Year - 1)
        Else
            yearGz = GetGanzhiYear(dateObj.Year)
        End If
        Return yearGz
    End Function

    ' 天干地支数组
    Private Shared tianGan() As String = {"甲", "乙", "丙", "丁", "戊", "己", "庚", "辛", "壬", "癸"}
    Private Shared diZhi() As String = {"子", "丑", "寅", "卯", "辰", "巳", "午", "未", "申", "酉", "戌", "亥"}

    ' 返回干支年
    Public Shared Function GetGanzhiYear(y As Integer) As String
        Dim tgIndex As Integer = (y - 4) Mod 10
        Dim dzIndex As Integer = (y - 4) Mod 12
        Return tianGan(tgIndex) & diZhi(dzIndex)
    End Function

    ' 计算干支日（需根据参考日期推算）
    Public Shared Function GetGanzhiDay(d As Date) As String
        ' 参照日：1900-01-31 为甲辰
        Dim refDate As Date = #1/31/1900#
        Dim refGan As Integer = 0 ' 甲 -> 0
        Dim refZhi As Integer = 4 ' 辰 -> index 4
        Dim offset As Integer = DateDiff(DateInterval.Day, refDate, d)

        Dim tgIndex As Integer = (refGan + offset) Mod 10
        If tgIndex < 0 Then tgIndex += 10
        Dim dzIndex As Integer = (refZhi + offset) Mod 12
        If dzIndex < 0 Then dzIndex += 12

        Return tianGan(tgIndex) & diZhi(dzIndex)
    End Function

    ' 计算干支月（简化算法，非节气精确版）
    Public Shared Function GetGanzhiMonth(y As Integer, m As Integer) As String
        ' 按农历推算: 以正月为丙寅，每月增加1地支
        ' 某年干配合月份
        Dim yearGanIndex As Integer = (y - 4) Mod 10
        ' 正月对应天干索引
        Dim firstMonthGanIndex As Integer = (yearGanIndex * 2 + 2) Mod 10
        Dim monthTgIndex As Integer = (firstMonthGanIndex + m - 1) Mod 10
        Dim monthDzIndex As Integer = (m + 2) Mod 12
        Return tianGan(monthTgIndex) & diZhi(monthDzIndex)
    End Function

    ' 计算干支时
    Public Shared Function GetGanzhiHour(dayGan As String, hour As Integer) As String
        ' 根据时辰地支
        Dim hourZhiIndex As Integer
        If hour = 23 Then
            hourZhiIndex = 0
        Else
            hourZhiIndex = ((hour + 1) \ 2) Mod 12
        End If
        ' 日干序号
        Dim dayGanIndex As Integer = Array.IndexOf(tianGan, dayGan)
        ' 时干公式
        Dim hourGanIndex As Integer = (dayGanIndex * 2 + hourZhiIndex) Mod 10
        Return tianGan(hourGanIndex) & diZhi(hourZhiIndex)
    End Function


    ' 返回给定日期的节气（如果有的话）
    Public Shared Function GetSolarTermName(dateObj As Date) As String
        Dim year As Integer = dateObj.Year
        For i As Integer = 0 To 23
            Dim termDate As Date = GetSolarTermDay(year, i)
            If termDate.Date = dateObj.Date Then
                Return solarTermNames(i)
            End If
        Next
        Return ""
    End Function


    ' 公历转农历
    Public Shared Function SolarToLunar(solarDate As Date) As (Integer, Integer, Integer, Boolean)
        Dim minYear As Integer = 1900
        Dim maxYear As Integer = 2100

        Dim y = solarDate.Year
        If y < minYear OrElse y > maxYear Then
            Throw New ArgumentOutOfRangeException($"农历转换支持 {minYear} - {maxYear}")
        End If

        Dim baseDate As Date = #1/31/1900#
        Dim offset As Integer = CInt((solarDate.Date - baseDate).TotalDays)

        Dim lunarYear As Integer = minYear
        While offset >= YearDays(lunarYear)
            offset -= YearDays(lunarYear)
            lunarYear += 1
        End While

        Dim leapMonth As Integer = GetLeapMonth(lunarYear)
        Dim lunarMonth As Integer = 1
        Dim isLeap As Boolean = False

        While True
            Dim monthDays_tmp As Integer
            If leapMonth > 0 AndAlso lunarMonth = leapMonth + 1 AndAlso Not isLeap Then
                lunarMonth -= 1
                isLeap = True
                monthDays_tmp = LeapDays(lunarYear)
            Else
                monthDays_tmp = MonthDays(lunarYear, lunarMonth)
            End If

            If offset < monthDays_tmp Then Exit While

            offset -= monthDays_tmp
            If isLeap AndAlso lunarMonth = leapMonth Then
                isLeap = False
            End If
            lunarMonth += 1
        End While

        Dim lunarDay As Integer = offset + 1
        Return (lunarYear, lunarMonth, lunarDay, isLeap)
    End Function


    ' 某年的总天数
    Private Shared Function YearDays(y As Integer) As Integer
        Dim sum As Integer = 348
        Dim flag As Integer = &H8000
        While flag > &H8
            If (lunarInfo(y - 1900) And flag) <> 0 Then sum += 1
            flag >>= 1
        End While
        Return sum + LeapDays(y)
    End Function

    ' 某月天数
    Private Shared Function MonthDays(y As Integer, m As Integer) As Integer
        If (lunarInfo(y - 1900) And (&H10000 >> m)) <> 0 Then
            Return 30
        Else
            Return 29
        End If
    End Function

    ' 获取闰月月份
    Private Shared Function GetLeapMonth(y As Integer) As Integer
        Return lunarInfo(y - 1900) And &HF
    End Function

    ' 闰月天数
    Private Shared Function LeapDays(y As Integer) As Integer
        If GetLeapMonth(y) <> 0 Then
            If (lunarInfo(y - 1900) And &H10000) <> 0 Then
                Return 30
            Else
                Return 29
            End If
        Else
            Return 0
        End If
    End Function

    ' 天干地支+生肖
    Public Shared Function GetLunarYearName(y As Integer) As String
        Dim tianGan() As String = {"甲", "乙", "丙", "丁", "戊", "己", "庚", "辛", "壬", "癸"}
        Dim diZhi() As String = {"子", "丑", "寅", "卯", "辰", "巳", "午", "未", "申", "酉", "戌", "亥"}
        Dim shengXiao() As String = {"鼠", "牛", "虎", "兔", "龙", "蛇", "马", "羊", "猴", "鸡", "狗", "猪"}
        Dim tgIndex As Integer = (y - 4) Mod 10
        Dim dzIndex As Integer = (y - 4) Mod 12
        Return tianGan(tgIndex) & diZhi(dzIndex) & "（" & shengXiao(dzIndex) & "）"
    End Function

    Public Shared Function GetLunarMonthName(m As Integer) As String
        Dim monthNames() As String = {"正", "二", "三", "四", "五", "六", "七", "八", "九", "十", "冬", "腊"}
        Return monthNames(m - 1)
    End Function

    Public Shared Function GetLunarDayName(d As Integer) As String
        Dim dayNum() As String = {"一", "二", "三", "四", "五", "六", "七", "八", "九", "十"}
        If d <= 10 Then
            Return "初" & dayNum(d - 1)
        ElseIf d <= 19 Then
            Return "十" & dayNum(d - 11)
        ElseIf d = 20 Then
            Return "二十"
        ElseIf d <= 29 Then
            Return "廿" & dayNum(d - 21)
        Else
            Return "三十"
        End If
    End Function

    Public Shared Function GetShiChen(hour As Integer) As String
        Dim shiChenNames() As String = {"子", "丑", "寅", "卯", "辰", "巳", "午", "未", "申", "酉", "戌", "亥"}
        If hour = 23 Then
            Return shiChenNames(0)
        Else
            Return shiChenNames(((hour + 1) \ 2) Mod 12)
        End If
    End Function

    ' 获取当前日期所属的节气信息（节气名、第几天、第几候）
    Public Shared Function GetTermProgress(dateObj As Date) As (String, Integer, Integer)
        Dim year As Integer = dateObj.Year
        Dim lastTermName As String = ""
        Dim lastTermDate As Date = Date.MinValue
        Dim nextTermDate As Date = Date.MaxValue

        ' 找到最近的节气（往前找一个，往后找一个）
        For i As Integer = 0 To 23
            Dim termDate As Date = GetSolarTermDay(year, i)
            If termDate.Date <= dateObj.Date AndAlso termDate > lastTermDate Then
                lastTermDate = termDate
                lastTermName = solarTermNames(i)
                ' 找下一节气
                If i = 23 Then
                    nextTermDate = GetSolarTermDay(year + 1, 0)
                Else
                    nextTermDate = GetSolarTermDay(year, i + 1)
                End If
            End If
        Next

        ' 如果跨年在1月初的情况
        If lastTermDate = Date.MinValue Then
            lastTermDate = GetSolarTermDay(year - 1, 23)
            lastTermName = solarTermNames(23)
            nextTermDate = GetSolarTermDay(year, 0)
        End If

        Dim dayNumber As Integer = (dateObj.Date - lastTermDate.Date).Days + 1
        Dim houNumber As Integer = CInt(Math.Ceiling(dayNumber / 5.0))

        Return (lastTermName, dayNumber, houNumber)
    End Function


End Class

